home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 096 / caller.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-03  |  7.0 KB  |  286 lines
  1. program caller;
  2.  
  3.  
  4. {This will analyze the CALLERS file produced by RBBS-PC and
  5. report on several things...
  6.  
  7.              How much time was used on-line
  8.              How many file were uploaded
  9.                                 downloaded
  10.                                 aborted
  11.             The files that are downloaded are then listed in
  12.               order of most popular with the number of times.
  13.  
  14. This ought to keep me busy for a while!!  }
  15.  
  16. const
  17.   userline = 'on at';
  18.   paged    = 'Operator paged';
  19.   download = 'Downloaded at';
  20.   upload   = '>> uploaded <<';
  21.   violation= 'SV!';
  22.   aborted  = 'Aborted at';
  23.   max_recs = 3500;
  24.  
  25. type
  26.   callertype = array [1..64] of char;
  27.   file_count = record fname : string[12];
  28.                       count : integer;
  29.                       end;
  30.  
  31. var
  32.   bigrec : array [1..128] of char;
  33.   inrec,hold : callertype;
  34.   x,y    : integer;
  35.   ch : char;
  36.   cfile  : file of callertype;
  37.   files  : array [1..max_recs] of file_count;
  38.   hour, minute, second : integer;
  39.   col, up, down, page, vio, ab, user  : integer;
  40.   fname : string[12];
  41.   placed : boolean;
  42.  
  43. procedure in_user;
  44. var st : string[2];
  45.     v,code : integer;
  46. begin
  47.   user := user + 1;
  48.   hold := inrec;
  49.   seek (cfile, x - 1);
  50.   read (cfile, inrec);
  51.   x := x - 1;
  52.   if inrec[64] = ' ' then
  53.     st := inrec[63]
  54.   else
  55.     st := inrec[63] + inrec[64];
  56.   val (st,v,code);
  57.   second := second + v;
  58.   if second > 59 then begin
  59.      second := second - 59;
  60.      minute := minute + 1;
  61.      if minute > 59 then begin
  62.         minute := minute - 59;
  63.         hour := hour + 1;
  64.         end;
  65.      end;
  66.   if inrec[61] = ' ' then
  67.     st := inrec[60]
  68.   else
  69.     st := inrec[60] + inrec[61];
  70.   val (st,v,code);
  71.   minute := minute + v;
  72.   if minute > 59 then begin
  73.      minute := minute - 59;
  74.      hour := hour + 1;
  75.      end;
  76.   if inrec[58] = ' ' then
  77.     st := inrec[57]
  78.   else
  79.     st := inrec[57] + inrec[58];
  80.   val (st,v,code);
  81.   hour := hour + v;
  82. end;
  83.  
  84. procedure in_upload;
  85. begin
  86.   up := up + 1;
  87. end;
  88.  
  89. procedure in_download;
  90. var x : integer;
  91. begin
  92.   down := down + 1;
  93.   col := 8;
  94.   fname := '';
  95.   while inrec[col] in ['A'..'Z','.','$','#','!','@','-','0'..'9'] do begin
  96.      fname := fname + inrec[col];
  97.      col := succ(col);
  98.      end;
  99.   x := 1;
  100.   placed := false;
  101.   while not placed do begin
  102.      if fname = files[x].fname then begin
  103.         files[x].count := files[x].count + 1;
  104.         placed := true;
  105.         end
  106.      else
  107.         if files[x].fname = '' then begin
  108.            files[x].fname := fname;
  109.            files[x].count := 1;
  110.            placed := true;
  111.            end;
  112.      x := x + 1;
  113.      end;
  114. end;
  115.  
  116. procedure in_aborted;
  117. begin
  118.   ab := ab + 1;
  119. end;
  120.  
  121. procedure in_violation;
  122. begin
  123.   vio := vio + 1;
  124. end;
  125.  
  126. procedure in_paged;
  127. begin
  128.   page := page + 1;
  129. end;
  130.  
  131. procedure init;
  132. begin
  133.   textcolor (cyan);
  134.   writeln ('Caller Check   (c) Copyright John Friel III');
  135.   writeln ('                             The Forbin Project');
  136.   writeln;
  137.   writeln ('For versions of RBBS-PC CPC12.3A and up.');
  138.   writeln;
  139.   hour := 0; minute := 0; second := 0; up := 0;
  140.   down := 0; page := 0; vio := 0; ab := 0; user := 0;
  141.   for x := 1 to max_recs do
  142.     with files[x] do begin                      { Zero  the counters }
  143.       count := 0;
  144.       fname := '';
  145.       end;
  146. end;
  147.  
  148. procedure openfiles;
  149. begin
  150.   assign (cfile, 'callers');
  151.   reset (cfile);
  152.   x := filesize(cfile);             { x hold the total records in the file }
  153.   writeln ('Total Records in the Callers file = ',x);
  154.   writeln;
  155.   writeln ('Working on record');
  156. end;
  157.  
  158. procedure scanfile;
  159. begin
  160.   while x > 0 do begin
  161.      gotoxy (19,8);
  162.      write (x:4);
  163.      seek (cfile, x - 1);
  164.      read (cfile, inrec);
  165.      x := x - 1;
  166.      if pos(userline, inrec) > 0 then
  167.        in_user
  168.      else
  169.        if pos(download, inrec) > 0 then
  170.          in_download
  171.        else
  172.          if pos(upload, inrec) > 0 then
  173.            in_upload
  174.          else
  175.            if pos(aborted, inrec) > 0 then
  176.              in_aborted
  177.            else
  178.              if pos(violation, inrec) > 0 then
  179.                in_violation
  180.              else
  181.                if pos(paged, inrec) > 0 then
  182.                  in_paged;
  183.     end;
  184.   writeln ('   Done.');
  185. end;
  186.  
  187. procedure output_results;
  188. begin
  189.   writeln;
  190.   write   ('Output destination [(S)creen, (P)rinter, (B)oth] ? ');
  191.   repeat
  192.     read (kbd,ch);
  193.     ch := upcase(ch);
  194.   until ch in ['S','P','B'];
  195.   writeln (ch);
  196.   if ch in ['B','S'] then begin
  197.      clrscr;
  198.      writeln ('Statistics are as follows:');
  199.      writeln ('  Downloads .... ',down);
  200.      writeln ('  Uploads ...... ',up);
  201.      writeln ('  Aborts ....... ',ab);
  202.      writeln ('  Violations ... ',vio);
  203.      writeln ('  Sysop paged .. ',page);
  204.      writeln ('  Users ........ ',user);
  205.      writeln ('  Time used .... ',hour,':',minute,':',second);
  206.      writeln ;
  207.      writeln ('  Files Downloaded : ');
  208.      writeln;
  209.      writeln ('  Tap any key to display downloaded files plus times downloaded.');
  210.      read (kbd,ch);
  211.      clrscr;
  212.      writeln;
  213.      writeln ('   Files Downloaded : ');
  214.      x := 1;
  215.      while files[x].fname <> '' do begin
  216.        write (' ',files[x].fname:15,'-',files[x].count:3);
  217.        x := succ(x);
  218.        if x/89 = int(x/89) then begin
  219.           writeln;
  220.           write ('  Tap any key to continue... ');
  221.           repeat until keypressed;
  222.           read (kbd,ch);
  223.           clrscr;
  224.           writeln ('   Files Downloaded : ');
  225.           end;
  226.        end;
  227.      end;
  228.   if ch in ['B','P'] then begin
  229.      writeln (lst,'Statistics are as follows:');
  230.      writeln (lst,'  Downloads .... ',down);
  231.      writeln (lst,'  Uploads ...... ',up);
  232.      writeln (lst,'  Aborts ....... ',ab);
  233.      writeln (lst,'  Violations ... ',vio);
  234.      writeln (lst,'  Sysop paged .. ',page);
  235.      writeln (lst,'  Users ........ ',user);
  236.      writeln (lst,'  Time used .... ',hour,':',minute,':',second);
  237.      writeln (lst);
  238.      writeln (lst,'  Files Downloaded : ');
  239.      x := 1;
  240.      while files[x].fname <> '' do begin
  241.        write (lst,' ',files[x].fname:15,'-',files[x].count:3);
  242.        x := succ(x);
  243.        end;
  244.      end;
  245. end;
  246.  
  247. procedure sort_download_files;
  248. var
  249.   high : integer;
  250.   done : boolean;
  251.   temp : file_count;
  252.  
  253.   procedure swapit (x : integer);
  254.   begin
  255.     temp := files[x];
  256.     files[x] := files[x+1];
  257.     files[x+1] := temp;
  258.     done := false;
  259.   end;
  260.  
  261. begin
  262.   writeln;
  263.   write ('Sorting by download frequency and ascending filename..  ');
  264.   high := 0;
  265.   for x := 1 to max_recs do
  266.     if files[x].count <> 0 then high := high + 1;
  267.   { do a quick bubble sort of the data...   quick ?!? }
  268.   repeat
  269.     done := true;
  270.     for x := 1 to high-1 do begin
  271.       if files[x].count < files[x+1].count then swapit(x);
  272.       if (files[x].count = files[x+1].count) and
  273.          (files[x].fname > files[x+1].fname) then swapit(x);
  274.       end;
  275.   until done;
  276.   writeln ('Done. '^J^M);
  277. end;
  278.  
  279. begin
  280.   init;
  281.   openfiles;
  282.   scanfile;
  283.   sort_download_files;
  284.   output_results;
  285. end.
  286.